home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.003 / stk-3 / stk / 3.1 / STk / Lentry.stklos < prev    next >
Encoding:
Text File  |  1996-07-29  |  2.5 KB  |  75 lines
  1. ;;;;
  2. ;;;; L e n t r y  . s t k       --  Labeled Entry composite widget
  3. ;;;;
  4. ;;;; Copyright ⌐ 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
  5. ;;;; 
  6. ;;;; Permission to use, copy, and/or distribute this software and its
  7. ;;;; documentation for any purpose and without fee is hereby granted, provided
  8. ;;;; that both the above copyright notice and this permission notice appear in
  9. ;;;; all copies and derived works.  Fees for distribution or use of this
  10. ;;;; software or derived works may only be charged with express written
  11. ;;;; permission of the copyright holder.  
  12. ;;;; This software is provided ``as is'' without express or implied warranty.
  13. ;;;;
  14. ;;;;           Author: Erick Gallesio [eg@kaolin.unice.fr]
  15. ;;;;    Creation date: 22-Mar-1994 13:05
  16. ;;;; Last file update:  2-Jul-1996 12:08
  17.  
  18. (require "Tk-classes")
  19.  
  20. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  21. ;;;;
  22. ;;;; <Labeled-Entry> class definition
  23. ;;;;
  24. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25.  
  26. (define-class <Labeled-entry> (<Tk-composite-widget> <Entry>)
  27.   ((entry     :accessor   entry-of)
  28.    (label     :accessor   label-of)
  29.    ;; Fictive slots
  30.    (title     :accessor    title
  31.          :init-keyword    :title
  32.          :allocation    :propagated
  33.          :propagate-to    ((label text)))
  34.    (title-width     :accessor    title-width
  35.          :init-keyword    :title-width
  36.          :allocation    :propagated
  37.          :propagate-to    ((label width)))
  38.    (anchor      :accessor    anchor
  39.          :init-keyword    :anchor
  40.          :allocation    :propagated
  41.          :propagate-to    (label))
  42.    (background     :accessor    background
  43.          :init-keyword    :background
  44.          :allocation    :propagated
  45.          :propagate-to    (frame entry label))
  46.    (foreground     :accessor    foreground
  47.          :init-keyword    :foreground
  48.          :allocation    :propagated
  49.          :propagate-to    (entry label))
  50.    (border-width :accessor    border-width 
  51.          :allocation    :propagated
  52.          :init-keyword    :border-width
  53.          :propagate-to    (frame))
  54.    (relief     :accessor    relief
  55.          :init-keyword    :relief
  56.          :allocation    :propagated
  57.          :propagate-to    (frame))
  58.    (entry-relief :accessor    dentry-relief
  59.          :init-keyword    :entry-relief
  60.          :allocation    :propagated
  61.          :propagate-to    ((entry relief)))  ))
  62.  
  63. (define-method initialize-composite-widget ((self <Labeled-entry>) initargs frame)
  64.   (let* ((e (make <Entry> :parent frame :relief "ridge"))
  65.      (l (make <Label> :parent frame)))
  66.  
  67.     (pack l :side "left")
  68.     (pack e :side "right" :expand #t :fill "x")
  69.  
  70.     (slot-set! self 'Id     (slot-ref e 'Id))
  71.     (slot-set! self 'entry  e)
  72.     (slot-set! self 'label  l)))
  73.  
  74. (provide "Lentry")
  75.